home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / qbtools1.arc / AEPULMEN.BAS < prev    next >
BASIC Source File  |  1987-12-10  |  7KB  |  300 lines

  1. rem $linesize:132
  2. rem $title:'Application Engineer Standard Routines'
  3. rem $subtitle:'Pull down menus - one ALWAYS highlit'
  4. '                Include the COMMON values
  5. rem $include:'AESHARED.BAS'            
  6.     
  7. sub Pull.Down.Menu static
  8. '
  9. '  Pull.Down.Menu
  10. '
  11. '  Will display a menu bar and list of horizontal options. The first
  12. '  horizontal option is highlit, with a list of options in a vertical
  13. '  format highlit under this bar. By using the up & down arrow keys, the
  14. '  options are selected (inverse video). By pressing the ENTER key, the
  15. '  selected option is returned in menop% . Using the left & right arrow
  16. '  keys moves the menu selection block left & right. Multiple selections
  17. '  are therefore possible in a menu, i.e menu & submenu. The values returned
  18. '  are menu% (horizontal selection) and menop% (the selection made within
  19. '  this sub-menu).
  20. '
  21. '  Help numbers are available in a passed array (ae.hlp%). These are used
  22. '  in linking the options with help 'frames'.
  23. '
  24.  
  25.         dim m.disp$(12%)
  26.  
  27.         locate ,,0
  28.         ae.sstack%=ae.sstack%+2000%
  29.         if ae.sstack%>10000% then
  30.             call ae.error("PDM AESTACK Overflow")
  31.         end if
  32.         frame.text$="   "                      ' Initial three spaces
  33.         for j%=1% to mcount%
  34.             frame.text$=frame.text$+ae.menu$(j%)+"  "
  35.         next j%
  36.  
  37.         max.l%=0%
  38.         res.yes%=0%
  39.         chop%=1%
  40.         high%=(ae.fg%(1%) and 7%)*16% + ae.hg%(1%)
  41.         norm%=(ae.bg%(1%) and 7%)*16% + ae.fg%(1%)
  42.         mch%=1%
  43.         m.prev%=1%
  44.         init%=1%
  45.         cycle%=0%
  46.         mbase%=mcount%
  47.         chk%=0%
  48.         alt%=0%
  49.         cur.up%=0%
  50.         cur.down%=0%
  51.         stor%=0%
  52.         menu%=0%
  53.         menop%=0%
  54.  
  55.         for j%=1% to mcount%
  56.             if ae.op%(j%)>max.l% then
  57.                 max.l%=ae.op%(j%)
  58.             end if
  59.         next j%
  60.  
  61.         call getscreen(ae.screens%(ae.sstack%-1999%),2%,1%,4%,80%,0%,0%) ' get where title bars
  62.  
  63.         max.l%=max.l%+5%
  64.  
  65.         frame.text$=frame.text$+string$(75%-len(frame.text$),32%)
  66.         frame.text$=chr$(179%)+frame.text$+chr$(179%)
  67.         frame.top$=chr$(218%)+string$(len(frame.text$)-2%,196%)+chr$(191%)
  68.         frame.bot$=chr$(192%)+string$(len(frame.text$)-2%,196%)+chr$(217%)
  69.  
  70.         call xqprint (frame.top$,2,1,norm%,0%)
  71.         call xqprint (frame.text$,3,1,norm%,0%)
  72.         call xqprint (frame.bot$,4,1,norm%,0%)
  73.  
  74.         for j%=1% to mch%-1%
  75.             mbase%=mbase%+ae.op%(j%)
  76.         next j%
  77.  
  78.         while cycle%=0%
  79.  
  80.             if init%=0% then
  81.                 call Get.Single(chk%,alt%)
  82.             end if
  83.  
  84.             if alt%=2% then
  85.  
  86.                 if chk%=75% then                  ' Cursor left
  87.                     mch%=mch%-1%
  88.                     chop%=1%
  89.                 end if
  90.  
  91.                 if chk%=77% then                  ' Cursor Right
  92.                     mch%=mch%+1%
  93.                     chop%=1%
  94.                 end if
  95.  
  96.                 if chk%=80% then                  ' Cursor Down
  97.                     chop%=chop%+1%
  98.                     cur.down%=1%
  99.                 end if
  100.  
  101.                 if chk%=72% then                  ' Cursor Up
  102.                     chop%=chop%-1%
  103.                     cur.up%=1%
  104.                 end if
  105.  
  106.             end if
  107.  
  108.             if mch%<1% then
  109.                 mch%=mcount%
  110.             end if
  111.  
  112.             if mch%>mcount% then
  113.                 mch%=1%
  114.             end if
  115.  
  116.             if chop%>ae.op%(mch%) then
  117.                 chop%=1%
  118.             end if
  119.  
  120.             if chop%<1% then
  121.                 chop%=ae.op%(mch%)
  122.             end if
  123.  
  124.             if alt%=1% then                      ' Return Pressed
  125.  
  126.                 if chk%=13% then
  127.                     cycle%=1%
  128.                 end if
  129.  
  130.                 if chk%=27% then                 ' Escape key
  131.                     cycle%=2%
  132.                     chk%=13%
  133.                 end if
  134.  
  135.                 if chk%<>13% then
  136.                     char$=chr$(chk%)
  137.                     call upcase(char$)
  138.                     stor%=chop%
  139.                     for k%=1% to ae.op%(mch%)
  140.                         stor%=stor%+1%
  141.                         if stor%>ae.op%(mch%) then
  142.                             stor%=1%
  143.                         end if
  144.                         if mid$(ch.skip$,stor%,1%)=char$ then
  145.                             chop%=stor%
  146.                             k%=ae.op%(mch%)+1%
  147.                             cur.up%=1%
  148.                         end if
  149.                     next k%
  150.                 end if
  151.  
  152.             end if
  153.  
  154.             if (abs(m.prev%-mch%)+cur.up%+cur.down%+init%)<>0% then
  155.  
  156.                 if (cur.up%+cur.down%)=0% then
  157.                     if res.yes%=1% then
  158.                         call putscreen(ae.screens%(ae.sstack%-999%),sr.1%,sr.2%,sr.3%,sr.4%,sr.5%,0)
  159.                         res.yes%=0%
  160.                     end if
  161.                 end if
  162.  
  163.                 mbase%=mcount%
  164.                 for j%=1% to mch%-1%
  165.                     mbase%=mbase%+ae.op%(j%)
  166.                 next j%
  167.  
  168.                 while ae.menu$(mbase%+chop%)=""
  169.                     if cur.down% then
  170.                         chop%=chop%+1%
  171.                     end if
  172.                     if cur.up% then
  173.                         chop%=chop%-1%
  174.                     end if
  175.                     if chop%>ae.op%(mch%) then
  176.                         chop%=1%
  177.                     end if
  178.                     if chop%<1% then
  179.                         chop%=ae.op%(mch%)
  180.                     end if
  181.                 wend
  182.  
  183.                 m.prev%=mch%
  184.                 mlen%=len(ae.menu$(mch%))
  185.                 mlen.top%=mlen%
  186.  
  187.                 for j%=1% to ae.op%(mch%)
  188.                     if len(ae.menu$(mbase%+j%))>mlen% then
  189.                         mlen%=len(ae.menu$(mbase%+j%))
  190.                     end if
  191.                 next j%
  192.  
  193.                 mlen%=mlen%+3%
  194.                 mlen.top%=mlen.top%+3%
  195.                 ch.skip$=string$(ae.op%(mch%),32%)
  196.                 for j%=1% to ae.op%(mch%)
  197.  
  198.                     if j%=chop% then
  199.                         fill.1$=chr$(175%)
  200.                         fill.2$=chr$(174%)
  201.                     else
  202.                         fill.1$=" "
  203.                         fill.2$=" "
  204.                     end if
  205.  
  206.                     if len(ae.menu$(mbase%+j%))=0% then
  207.                         m.disp$(j%)=chr$(195%)+string$(mlen%-1%,196%)+chr$(180%)
  208.                     else
  209.                         chkin$=mid$(ae.menu$(mbase%+j%),1%,1%)
  210.                         call upcase(chkin$)
  211.                         mid$(ch.skip$,j%,1%)=chkin$
  212.                         m.disp$(j%)=chr$(179%)+fill.1$+ae.menu$(mbase%+j%)
  213.                         m.disp$(j%)=m.disp$(j%)+string$((mlen%-1%)-len(m.disp$(j%)),32%)+fill.2$+chr$(179%)
  214.                     end if
  215.  
  216.                 next j%
  217.  
  218.                 if (cur.down%+cur.up%)=0% then
  219.  
  220.                     m.bottom$=chr$(192%)+string$(mlen%-1%,chr$(196%))+chr$(217%)
  221.                     m.top$=chr$(197%)+string$(mlen%-1%,chr$(196%))+chr$(194%)
  222.  
  223.                     if mlen%=mlen.top% then
  224.                         mid$(m.top$,len(m.top$),1)=chr$(197%)
  225.                     else
  226.                         mid$(m.top$,len(ae.menu$(mch%))+4%,1%)=chr$(193%)
  227.                     end if
  228.  
  229.                     q%=instr(frame.text$,ae.menu$(mch%))-2%
  230.  
  231.  
  232.                     call xqprint (frame.top$,2,1,norm%,0%)
  233.                     call xqprint (frame.text$,3,1,norm%,0%)
  234.                     call xqprint (frame.bot$,4,1,norm%,0%)
  235.                     call xqprint (chr$(194),2%,q%,norm%,0%)
  236.                     call xqprint (chr$(179),3%,q%,norm%,0%)
  237.                     call xqprint (chr$(194),2%,q%+3%+len(ae.menu$(mch%)),norm%,0%)
  238.                     call xqprint (chr$(179),3%,q%+3%+len(ae.menu$(mch%)),norm%,0%)
  239.                     call xqprint (m.top$,4%,q%,norm%,0%)
  240.  
  241.                 end if
  242.  
  243.                 if res.yes%=0% then
  244.                     call getscreen(ae.screens%(ae.sstack%-999%),5%,q%,5%+ae.op%(mch%),q%+mlen%+3%,0%,0%)
  245.                     sr.1%=5%
  246.                     sr.2%=q%
  247.                     sr.3%=5%+ae.op%(mch%)
  248.                     sr.4%=q%+mlen%+3%
  249.                     sr.5%=0%
  250.                     sr.6%=1%
  251.                     res.yes%=1%
  252.                 end if
  253.  
  254.                 for j%=1% to ae.op%(mch%)
  255.  
  256.                     if j%<>chop% then
  257.                         call xqprintd(m.disp$(j%),j%+4%,q%,norm%,0%)
  258.                     end if
  259.  
  260.                     if j%=chop% then
  261.                         sbeg$=mid$(m.disp$(j%),1%,1%)
  262.                         smid$=mid$(m.disp$(j%),2%,len(m.disp$(j%))-1%)
  263.                         send$=mid$(m.disp$(j%),len(m.disp$(j%)),1%)
  264.                         call xqprintd(sbeg$,j%+4%,q%,norm%,0%)
  265.                         call xqprintd(smid$,j%+4%,q%+1%,high%,0%)
  266.                         call xqprintd(send$,j%+4%,q%+len(smid$),norm%,0%)
  267.                     end if
  268.  
  269.                 next j%
  270.  
  271.                 if (cur.down%+cur.up%)=0% then
  272.                     call xqprint(m.bottom$,4%+ae.op%(mch%)+1%,q%,norm%,0%)
  273.                 end if
  274.  
  275.             end if
  276.  
  277.             cur.up%=0%
  278.             cur.down%=0%
  279.             init%=0%
  280.         wend
  281.  
  282.         if res.yes%=1% then
  283.             call putscreen(ae.screens%(ae.sstack%-999%),sr.1%,sr.2%,sr.3%,sr.4%,sr.5%,0)
  284.         end if
  285.  
  286.         call putscreen(ae.screens%(ae.sstack%-1999%),2%,1%,4%,80%,0%,0%)
  287.         ae.sstack%=ae.sstack%-2000%
  288.  
  289.         if cycle%=1% then
  290.             menu%=mch%                 ' Menu Chosen
  291.             menop%=chop%               ' Option within that menu
  292.         end if
  293.  
  294.         if cycle%=2% then              ' ESCAPE option
  295.             menu%=0%
  296.             menop%=0%
  297.         end if
  298.  
  299.     end sub
  300.